home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Night Owl 6
/
Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso
/
037a
/
wedits22.zip
/
WEINPUT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-08-19
|
11KB
|
423 lines
UNIT WEInput;
{ -- This is the Input Module of WWIVEdit 2.2
-- Last Modified: 8/19/91
-- Written By:
-- Adam Caldwell
--
-- This code is limited Public Domain (see WWIVEDIT.PAS for more details)
--
-- Purpose : Encapsulate as much of the input as possible
--
-- Known Errors : None
--
-- Planned Enhancements : None
-- }
INTERFACE
{$R-,V-,S-,B-,E-,N-} { These Optomize things as much as possible }
USES WEVars;
CONST
TimingConstant=8;
FUNCTION GetKey:char;
FUNCTION GetControlLine:String;
FUNCTION ReadSet(s:charset):char;
FUNCTION GetArrow : Edfun;
FUNCTION GetFun(VAR ch:char):EdFun;
FUNCTION TimeKey(n : word) : char;
FUNCTION Yn : boolean;
IMPLEMENTATION
USES WETime, WEChat, WEKbd, WEOutput;
FUNCTION GetBoxChar(setn, ch:char) : Char;
{ Allows insertion of a line drawing character... needs major work }
CONST
boxes:ARRAY['1'..'4'] OF string[9] =
( '█▄▓▌ ▐▒▀░','└─┘│ │┌─┐','╚═╝║ ║╔═╗',' ┴ ├┼┤ ┬ ');
BEGIN
GetBoxChar:=boxes[setn][ord(ch)-ord('0')]
END;
FUNCTION GetExtendedCommand1:EdFun;
{ Gets Extended command from ^K key (mostly block commands) }
VAR
ch:char;
Fun : EdFun;
Fast : Boolean;
BEGIN
Fast:=KeyPressed;
IF NOT Fast THEN
StatusLine3(C0+'^K');
Fun := None;
ch:=GetKey;
IF (NOT Fast) AND (ch IN [#32..#255]-[#127]) THEN prompt(ch);
CASE upcase(ch) OF
'U' : Fun := Up; 'D' : Fun := Down; 'L' : Fun := Left;
'R' : Fun := Right;
'B' : Fun := MarkStart;
'E','K' : Fun := MarkEnd;
'M','V' : Fun := MoveBlock;
'S' : Fun := ShowBlockStat;
'C' : Fun := CopyBlock;
'Y' : Fun := DeleteBlock;
'W' : Fun := ToggleWhere;
'J' : Fun := Jump;
END;
GetExtendedCommand1:=Fun;
IF NOT Fast THEN
StatusLine3('');
END;
FUNCTION GetExtendedCommand2(VAR ch:char):EdFun;
{ Gets Extended command off of ^Q... Still works for insertLiteral too }
VAR
Fun:EdFun;
c : char;
Fast : boolean;
BEGIN
Fast:=KeyPressed;
IF NOT Fast THEN
StatusLine3(C0+'^Q');
Fun := None;
ch:=GetKey;
IF (NOT Fast) AND (ch IN [#32..#255]-[#127]) THEN prompt(ch);
IF ch IN [#0..#31,#127] THEN Fun:=InsertChar;
CASE upcase(ch) OF
'Y' : Fun := DelEOL;
'F' : Fun := Find;
'L' : Fun := FindLast;
'1'..'4' : BEGIN
c:=GetKey;
Fun:=InsertChar;
IF c IN ['0'..'9'] THEN
ch:=GetBoxChar(ch,c)
ELSE Fun:=None;
END;
END;
GetExtendedCommand2:=Fun;
IF NOT Fast THEN
StatusLine3('');
END;
FUNCTION GetFun(VAR ch:char):EdFun;
{ Does type bulk of the keyboard interpretation... Melts all of the different
input styles together [IBM, ANSI, & Control Keys] }
VAR
r:ExtTrans;
s,s1:string;
i:integer;
t:text;
BEGIN
GetFun:=None;
ch:=GetKey;
IF NOT (ch IN [#0..#31,#127]) THEN GetFun:=InsertChar;
IF CH in EditorKeys THEN
CASE ch of
DelWordLeft : GetFun:=EraseWordLeft;
FastLeft : GetFun:=WordLeft; FastRight : GetFun:=WordRight;
BackSpaceKey : GetFun:=Backspace; _DEL_ : GetFun:=DelChar;
RedisplayKey : GetFun:=RedisplayAll; DelLineKey : GetFun:=DelLine;
TabKey : GetFun:=Tab; UpKey : GetFun:=Up;
PgUpKey : GetFun:=PgUp; LeftKey : GetFun:=Left;
RightKey : GetFun:=Right; DownKey : GetFun:=Down;
PgDnKey : GetFun:=PgDn; ToggleInsKey : GetFun:=ToggleInsert;
DelKey : GetFun:=DelChar;
EnterKey : GetFun:=Enter; WWIVColorKey : GetFun:=WWIVColor;
CenterLineKey: GetFun:=CenterLine; DelSOLKey : GetFun:=DelSOL;
HelpKey : GetFun:=GetHelp; DelLeftKey : GetFun:=GoBack;
RepeatLastFindKey : GetFun:=FindLast;
ToggleFullScreenKey : GetFun :=ToggleFullScreen;
ExtendedKey1 : GetFun:=GetExtendedCommand1;
ExtendedKey2 : GetFun:=GetExtendedCommand2(ch);
END
ELSE IF Ch=#0 THEN
BEGIN
ch:=GetKey;
CASE ch OF
#71:GetFun := Home; #72:GetFun := Up; #73:GetFun := PgUp;
#75:GetFun := Left; #77:GetFun := Right;
#79:GetFun := _End; #80:GetFun := Down; #81:GetFun := PgDn;
#82:GetFun:=ToggleInsert; #83:GetFun := DelChar;
#119,#132:GetFun := Top; { Ctrl-Home Ctrl-PgDn }
#117,#118:GetFun := Bottom; { Ctrl-End Ctrl-PgDn }
#115:GetFun := WordLeft; { Ctrl-Left Arrow }
#116:GetFun := WordRight; { Ctrl-Right Arrow }
#59 :GetFun := GetHelp; { F1 }
#30 :GetFun := AbortPost; { Alt-A }
#31 :GetFun := ExitAndSave; { Alt-S }
#17 :GetFun := SaveAndContinue;{ Alt-W }
#46 :GetFun := CenterLine; { Alt-C }
#25 :GetFun := WWIVColor; { Alt-P }
ELSE IF TrueKeyboard THEN
CASE ch OF
#23 :GetFun := InsertFile; { Alt-I }
#68 :BEGIN Chat(LineLen,ScreenHeight); ch:=#0; GetFun:=None END; {F10}
ELSE
BEGIN
GetFun:=None;
IF OkLocalMacros THEN
BEGIN
reset(transtable);
seek(transtable,ord(ch));
read(transtable,r);
s:='';
IF r[1]<>#0 THEN
BEGIN
s:=s+r[1]+r[2]+r[3];
IF r[2]=#0 THEN s[0]:=#1
ELSE if r[3]=#0 THEN s[0]:=#2;
END;
IF s<>'' THEN
BEGIN
assign(t,StartupDir+'MACROS.LCL');
reset(t);
WHILE (NOT EOF(t)) AND (s1<>s+':') DO
readln(t,s1);
IF s1=s+':' THEN
REPEAT
readln(t,s1);
IF (length(s1)>0) AND (s1[1]=^B) THEN BEGIN
s1[1]:='/';
system.insert('C:',s1,2)
END;
IF (length(s1)>0) AND (s1[1]='~') THEN
system.delete(s1,1,1);
IF s1[length(s1)]<>'~'
THEN s1:=s1+^M
ELSE system.delete(s1,length(s1),1);
FOR i:=1 TO length(s1) DO
CASE s1[i] OF
^C : s1[i]:=WWIVColorKey;
^H : s1[i]:=DelLeftKey;
END;
IF s1<>':'+s+^M THEN StuffIn(s1);
UNTIL s1=':'+s+^M;
close(t);
END;
END
END;
END
END;
END;
IF ch=#$E0 THEN BEGIN
IF empty
THEN ch:=TimeKey(TimingConstant)
ELSE ch:=ReadKey;
IF ch=#255 THEN BEGIN
GetFun:=InsertChar;
ch:=#$E0;
END ELSE
CASE ch OF
#$48 : GetFun:=Up;
#$50 : GetFun:=Down;
#$4B : GetFun:=Left;
#$4D : GetFun:=Right;
#$1C : GetFun:=Enter;
#$52 : GetFun:=ToggleInsert;
#$47 : GetFun:=Home;
#$49 : GetFun:=PgUp;
#$51 : GetFun:=PgDn;
#$4F : GetFun:=_End;
#$53 : GetFun:=DelChar
ELSE BEGIN
StuffIn(ch);
ch:=#$E0;
GetFun:=InsertChar
END;
END;
END;
IF ch=#27 THEN BEGIN
IF empty
THEN ch:=timekey(TimingConstant)
ELSE ch:=GetKey;
IF ch=#255 THEN GetFun := NormalExit;
IF ch<>#255 THEN
IF (ch='[') OR (ch='O') THEN
BEGIN
ch:=GetKey;
CASE ch OF
'H' : GetFun:=Home; 'A' : GetFun:=Up;
'D' : GetFun:=Left; 'C' : GetFun:=Right;
'K' : GetFun:=_End; 'B' : GetFun:=Down;
'r' : GetFun:=ToggleInsert; 'n' : GetFun:=DelChar;
'P' : GetFun:=GetHelp;
END
END
ELSE IF upcase(ch)='S' THEN
BEGIN
GetFun := ExitAndSave;
END
ELSE GetFun:=NormalExit
END;
END;
FUNCTION GetKey:CHAR;
VAR
warned : boolean;
ch : char;
BEGIN
BeforeNext;
LastKey := timer;
Warned:=false;
REPEAT
IF (KeyStatusFlag AND 3)=3 THEN BEGIN {Enter Chat mode by hitting both }
Chat(LineLen,ScreenHeight); {Shift keys at once }
LastKey:=Timer;
Warned:=False;
END;
IF (KeyStatusFlag AND 12)=12 THEN {Control & Alt Together }
Local:=TRUE;
(* IF (KeyStatusFlag AND 6)=6 THEN {control & left shift together } *)
(* Local:=FALSE; *) { Some people complained about this one... uncomment if you want it }
IF LastKey>Timer THEN LastKey:=0; {Special case for midnight }
IF (Not warned) AND (Timer-Lastkey>WarnTime) THEN
BEGIN
IF NOT Local THEN
warned := TRUE;
write(#7#7#7);
END;
UNTIL (KeyPressed) OR (Timer-Lastkey>DisconnectTime);
IF KeyPressed THEN
GetKey:=ReadKey
{ BEGIN
ch := readkey;
IF (ch=#0) AND (NOT TrueKeyboard)
THEN GetKey:=ReadKey
ELSE GetKey:=ch;
END}
ELSE BEGIN
clrscr;
Print('Editor Time-Out');
Halt
END;
AfterNext;
END;
FUNCTION GetControlLine:String;
{ Allows user to input a line, and shows all "control" characters as inverted }
VAR
s:string;
ch:char;
BEGIN
s:='';
StatusLine2(C0);
REPEAT
ch:=GetKey;
IF not (ch in [^H,^Z]) THEN
BEGIN
s:=s+ch;
IF ch<#32
THEN WriteControl(ch)
ELSE write(ch);
END
ELSE IF (length(s)>0) AND (ch=^H) THEN
BEGIN
delete(s,length(s),1);
write(#8#32#8);
END;
UNTIL (ch=^Z) OR (length(s)=80);
GetControlLine:=s;
END;
FUNCTION ReadSet(s:charset):char;
{ Waits for a key from user, until user presses a key in the set S }
VAR ch:char;
BEGIN
REPEAT ch:=upcase(GetKey) UNTIL ch IN s;
ReadSet:=ch;
IF ch IN [#32..#126] THEN write(ch);
END;
FUNCTION TimeKey(n : word) : char;
VAR ch : char;
BEGIN
n:=n*100;
WHILE Empty AND (n > 0) DO
dec(n);
IF Empty
THEN ch := #255
ELSE ch:=readkey;
TimeKey := ch
END;
FUNCTION GetArrow : EdFun;
{ allows for the arrows [control key type, ibm type, and ANSI type], as well
as ENTER and ESC }
VAR
ch:char;
f:EdFun;
BEGIN
f:=None;
WHILE f=None DO
BEGIN
ch:=GetKey;
IF NOT (ch IN [#0,#27,EnterKey,LeftKey,RightKey,UpKey,DownKey]) THEN
F:=None;
IF CH in EditorKeys THEN
CASE ch of
UpKey : F:=Up;
LeftKey : F:=Left;
RightKey : F:=Right;
DownKey : F:=Down;
EnterKey : F:=Enter;
END
ELSE IF Ch=#0 THEN
BEGIN
ch:=GetKey;
CASE ch OF
#72 : F:=Up;
#75 : F:=Left;
#77 : F:=Right;
#80 : F:=Down;
END;
END;
IF ch=#27 THEN BEGIN
IF empty
THEN ch:=timekey(TimingConstant)
ELSE ch:=ReadKey;
IF ch=#255 THEN F := NormalExit;
IF ch<>#255 THEN
IF (ch='[') OR (ch='O') THEN
BEGIN
ch:=GetKey;
CASE ch OF
'A' : F:=Up;
'D' : F:=Left;
'C' : F:=Right;
'B' : F:=Down;
END
END
END
END;
getarrow:=f;
END;
FUNCTION yn : boolean;
VAR c : char;
BEGIN
ansic('1');
repeat
c:=upcase(readkey)
until (c IN ['Y','N',#13]);
IF (c = 'Y') OR (c=#13) THEN
BEGIN
print('Yes');
yn := true;
END ELSE
BEGIN
print('No');
yn := false;
END;
END;
END.